home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD020d.dsk / PIE CHART.bas < prev    next >
BASIC Source File  |  2003-06-12  |  9KB  |  232 lines
  1. 10  CLEAR : HOME : DIM L$(18): DIM V(18): DIM L1$(18): DIM V1(18): DIM LE$(4)
  2. 20  DIM PR(6):PR(1) = 1:PR(2) = 1:PR(3) = 1:PR(4) = 1:PR(5) = 1:PR(6) = 0: REM  PARAMETERS
  3. 30  DEF  FN X(C) = RA * SIN(C) +XC: DEF  FN Y(C) = RA *.9 * COS(C) +YC
  4. 40 PI = 3.1415926:DL = 25056: REM  CONSTANTS
  5. 50  VTAB 10: HTAB 15: PRINT "PIE CHART"
  6. 60  REM   LEGEND READER
  7. 70  REM  LEGENDS IN LE$(HF)
  8. 80  FOR HF = 2 TO 5
  9. 90 VF =  -1: GOSUB 2500:LE$(HF -1) = W$
  10. 100  IF  LEN(LE$(HF -1)) = 8  THEN 120
  11. 110 LE$(HF -1) = LE$(HF -1) +" ": GOTO 100: REM  ONE SPACE
  12. 120 VF = 0: GOSUB 2500:LE$(HF -1) = LE$(HF -1) +W$
  13. 130  NEXT HF
  14. 140  REM  OPTIONS I/O
  15. 150 TV = 0:LL = 0:NG = 0:CN = 0:NF = 0
  16. 160  HOME : HTAB 5: INVERSE : PRINT "SOFTGRAPH PIE CHART GENERATOR": NORMAL 
  17. 170  POKE 32,7: VTAB 3
  18. 180  FOR HF = 1 TO 4: PRINT "LEGEND ";HF;": ";LE$(HF): NEXT HF
  19. 190  POKE 32,1: PRINT 
  20. 200  PRINT "HOW MANY LABEL FIELDS (1 OR 2)?": PRINT : REM PR(1)
  21. 210  PRINT "CHART WHICH COLUMN (1 THROUGH 4)?": PRINT : REM PR(2)
  22. 220  PRINT "SORT: 0=DON'T; 1=VALUES; 2=LABELS:": PRINT : REM PR(3)
  23. 230  PRINT "COLOR: 0=NO; 1=YES:": PRINT : REM PR(4)
  24. 240  PRINT "STYLE: 0=SIDEWAYS; 1=UPRIGHT:": PRINT : REM  PR(5)
  25. 250  PRINT "ROTATION: -180 TO 180:": PRINT : REM PR(6)
  26. 260  TEXT 
  27. 270  FOR P = 1 TO 6: VTAB 6 +2 *P: HTAB 37: PRINT PR(P);: NEXT P
  28. 280  VTAB 20: HTAB 1: PRINT "ARROWS MOVE CURSOR": PRINT "SPACE SELECTS QUESTION": PRINT "CONTROL-P PROCESSES PIE CHART": PRINT "CONTROL-Q QUITS TO MENU"
  29. 290 P = 1
  30. 300  VTAB 6 +2 *P: HTAB 1: FLASH : PRINT ">";: NORMAL 
  31. 310  HTAB 1: GET A$
  32. 320 A =  ASC(A$)
  33. 330  IF A = 8  OR A = 21  THEN  VTAB 6 +2 *P: HTAB 1: PRINT " ";: GOTO 380
  34. 340  IF A = 32  THEN 430
  35. 350  IF A = 17  THEN 2400
  36. 360  IF A = 16  THEN 550
  37. 370  GOTO 310
  38. 380  REM  POINTER MOVE
  39. 390 P = P + SGN(A -10)
  40. 400  IF P = 0  THEN P = 6
  41. 410  IF P = 7  THEN P = 1
  42. 420  GOTO 300
  43. 430  REM  GET NEW VALUE
  44. 440  VTAB 24: HTAB 1: INVERSE : PRINT "ENTER NEW VALUE: ";: NORMAL :W$ = ""
  45. 450  VTAB 24: HTAB 18: PRINT W$;
  46. 460  GET A$:A =  ASC(A$)
  47. 470  IF A = 8  THEN 510
  48. 480  IF A = 13  THEN PR(P) =  VAL(W$): VTAB 6 +2 *P: HTAB 37: PRINT PR(P);: CALL  -868: VTAB 24: HTAB 1: CALL  -868: GOTO 300
  49. 490  IF A <45  OR A >57  OR A = 46  OR A = 47  OR  LEN(W$) = 4  THEN 450
  50. 500 W$ = W$ +A$: GOTO 450
  51. 510  IF  LEN(W$) = 1  THEN W$ = "": PRINT  CHR$(8);" ";
  52. 520  IF W$ = ""  THEN 450
  53. 530 W$ =  LEFT$(W$, LEN(W$) -1)
  54. 540  PRINT  CHR$(8);" ";: GOTO 450
  55. 550  REM  START PROCESSING
  56. 560  REM  CHECK PARAMETERS
  57. 570  VTAB 6 +2 *P: HTAB 1: PRINT " ";
  58. 580 P = 1: IF PR(P) <1  OR PR(P) >2  THEN 650
  59. 590 P = 2: IF PR(P) <1  OR PR(P) >4  THEN 650
  60. 600 P = 3: IF PP(P) <0  OR PR(P) >2  THEN 650
  61. 610 P = 4: IF PR(P) <0  OR PR(P) >1  THEN 650
  62. 620 P = 5: IF PR(P) <0  OR PR(P) >1  THEN 650
  63. 630 P = 6: IF  ABS(PR(P)) >180  THEN 650
  64. 640  GOTO 660
  65. 650  VTAB 6 +2 *P: HTAB 1: FLASH : PRINT ">"; CHR$(7);: NORMAL : VTAB 24: HTAB 1: PRINT "VALUE ILLEGAL";: GET A$: GOTO 310
  66. 660  REM  READ LABELS
  67. 670  HOME : PRINT "READING LABELS": PRINT 
  68. 680  FOR VF = 1 TO 18
  69. 690 HF = 1: GOSUB 2500:L$(VF) = W$
  70. 700  IF  LEN(W$) = 0  THEN NF = VF -1:VF = 18: GOTO 750
  71. 710  IF PR(1) = 1  THEN 750
  72. 720  IF  LEN(L$(VF)) = 8  THEN 740
  73. 730 L$(VF) = L$(VF) +" ": GOTO 720: REM  ONE SPACE
  74. 740 HF = 2: GOSUB 2500:L$(VF) = L$(VF) +W$
  75. 750  HTAB 5: PRINT L$(VF): NEXT VF: IF NF = 0  THEN NF = 18
  76. 760  REM  READ VALUES
  77. 770  PRINT "READING VALUES": PRINT 
  78. 780 HF = PR(2) +1: FOR VF = 1 TO NF
  79. 790  GOSUB 2500
  80. 800 V(VF) =  VAL(W$)
  81. 810  NEXT VF
  82. 820 LL = 0:GF = 1:NG = NF
  83. 830  FOR VF = 1 TO NF
  84. 840  IF V(VF) >0  THEN L1$(GF) = L$(VF):V1(GF) = V(VF): GOTO 880
  85. 850  PRINT "CANNOT GRAPH ";L$(VF);": ";V(VF)
  86. 860 SF = 1
  87. 870 NG = NG -1: GOTO 910
  88. 880  IF  LEN(L$(VF)) >LL  THEN LL =  LEN(L$(VF))
  89. 890  HTAB 5: PRINT L$(VF);: HTAB 25: PRINT V(VF)
  90. 900 GF = GF +1
  91. 910  NEXT VF
  92. 920  PRINT : IF NG = 0  THEN  PRINT "NO GRAPHABLE FIELDS FOUND": PRINT "HIT A KEY";: GET A$: GOTO 140
  93. 930  IF SF = 0  THEN 980
  94. 940 SF = 0: PRINT "OKAY TO CONTINUE? ";
  95. 950  GET A$: IF A$ < >"Y"  AND A$ < >"N"  THEN 950
  96. 960  IF A$ = "N"  THEN 140
  97. 970  PRINT : PRINT 
  98. 980  REM  SORTING
  99. 990  IF PR(3) = 0  THEN 1130
  100. 1000  PRINT "SORTING"
  101. 1010  FOR VF = 1 TO NG
  102. 1020 CF = 1
  103. 1030  FOR GF = 2 TO NG
  104. 1040  ON PR(3) GOTO 1070,1050
  105. 1050  IF L1$(GF) <L1$(CF)  THEN CF = GF
  106. 1060  GOTO 1080
  107. 1070  IF V1(GF) >V1(CF)  THEN CF = GF
  108. 1080  NEXT GF
  109. 1090 L$(VF) = L1$(CF):V(VF) = V1(CF):L1$(CF) =  CHR$(95):V1(CF) = 0
  110. 1100 TV = TV +V(VF)
  111. 1110  NEXT VF
  112. 1120  GOTO 1180
  113. 1130  REM   COPY DATA
  114. 1140  FOR VF = 1 TO NG
  115. 1150 L$(VF) = L1$(VF):V(VF) = V1(VF)
  116. 1160 TV = TV +V(VF)
  117. 1170  NEXT VF
  118. 1180  IF PR(3) = 0  THEN 1230
  119. 1190  PRINT : FOR VF = 1 TO NG
  120. 1200  HTAB 5
  121. 1210  PRINT L$(VF); TAB( 25);V(VF)
  122. 1220  NEXT : PRINT 
  123. 1230  PRINT "LEGEND: ";LE$(PR(2))
  124. 1240  PRINT : PRINT "LONGEST LABEL IS ";LL;" CHARACTERS"
  125. 1250  PRINT "TOTAL OF ALL VALUES IS ";TV
  126. 1260  PRINT : PRINT "FORMATTING CHART"
  127. 1270  REM  FORMAT CHART
  128. 1280 D = 1:F = 2: IF PR(5) = 0  THEN D = 4
  129. 1290 CO = PR(4)
  130. 1300  IF PR(5) = 0  THEN 1360
  131. 1310  ROT= 0
  132. 1320 RA = (280 -((LL +3) *6 +20))/2: IF RA >88  THEN RA = 88: REM  RADIUS
  133. 1330 XC = RA +4:YC = RA +12
  134. 1340 XW = 2 *RA +12:YW = (192 -(NF *7))/2
  135. 1350  GOTO 1400
  136. 1360 RA = (280 -((NG +4) *7))/2: IF RA >92  THEN RA = 92: REM    RADIUS
  137. 1370  ROT= 48
  138. 1380 XC = RA +13:YC = 96
  139. 1390 XW = RA *2 +12:YW = (192 +((LL +4) *6))/2
  140. 1400  HGR2 : HCOLOR= 3: HPLOT 0,0 TO 279,0 TO 279,191 TO 0,191 TO 0,0: SCALE= 1
  141. 1410 RA = RA +1: HPLOT  FN X(0), FN Y(0)
  142. 1420  FOR CD = 0 TO 2 *PI  STEP .04: HPLOT  TO  FN X(CD), FN Y(CD): NEXT :RA = RA -1
  143. 1430 C1 = PR(6) *2 *PI/360
  144. 1440  FOR NS = 1 TO NG
  145. 1450 C2 = C1 +V(NS) *2 *PI/TV
  146. 1460  ON PR(4) +1 GOSUB 3000,2900
  147. 1470 C1 = C2
  148. 1480  NEXT 
  149. 1490 PR(4) = CO
  150. 1500 W$ = LE$(PR(2)): IF PR(5) = 0  THEN X = 3:Y = (192 +( LEN(W$) *6))/2: GOSUB 9000: GOTO 1520
  151. 1510 X = (280 -( LEN(W$) *6))/2:Y = 3: GOSUB 9000
  152. 1520  HOME : GET A$
  153. 1530  TEXT : VTAB 1: PRINT "PIE CHART COMPLETED"
  154. 1540  PRINT : PRINT "   1. RETURN TO MENU"
  155. 1550  PRINT "   2. SEE CHART"
  156. 1560  PRINT "   3. RESET PARAMETERS"
  157. 1570  VTAB 7: HTAB 1: PRINT "WHAT NOW? ";: CALL  -868: GET A$:A =  VAL(A$)
  158. 1573  IF A <1  OR A >3  THEN 1570
  159. 1575  PRINT A$;
  160. 1577  GET A$: IF A$ =  CHR$(8)  THEN 1570
  161. 1580  IF A$ < > CHR$(13)  THEN 1577
  162. 1590  ON A GOTO 2400,1600,140
  163. 1600  POKE  -16304,0: POKE  -16299,0: GOTO 1520
  164. 2400  REM  RETURN TO MENU
  165. 2410  HOME : VTAB 10: PRINT "INSERT PROGRAM DISK IN DRIVE 1": PRINT "AND HIT ANY KEY. USE ESCAPE TO ABORT.";: GET A$
  166. 2415  IF A$ =  CHR$(27)  THEN 140
  167. 2420  PRINT : PRINT  CHR$(4);"RUN MENU,D1"
  168. 2500  REM READ WORD
  169. 2510 PL = DL +40 *(VF +1) +8 *(HF -1) -1
  170. 2520 WL = 0:W$ = ""
  171. 2530  FOR LOC = 8 TO 1  STEP  -1
  172. 2540  IF  PEEK(PL +LOC) >32  THEN WL = LOC:LOC = 1
  173. 2550  NEXT LOC
  174. 2560  IF WL = 0  THEN  RETURN 
  175. 2570  FOR LOC = 1 TO WL
  176. 2580 W$ = W$ + CHR$( PEEK(PL +LOC))
  177. 2590  NEXT LOC
  178. 2600  RETURN 
  179. 2700  REM  LABEL ROUTINE
  180. 2710 W$ = "- " +L$(NS)
  181. 2720  IF PR(5) = 1  THEN 2780
  182. 2730  REM  SIDEWAYS
  183. 2740 XW = XW +7:X = XW:Y = YW -12: GOSUB 9000
  184. 2750  IF PR(4) = 0  THEN 2840
  185. 2760  HCOLOR= CN: FOR Y = YW -2 TO YW +3: HPLOT XW,Y TO XW +4,Y: NEXT Y
  186. 2770  GOTO 2850
  187. 2780  REM  UPRIGHT
  188. 2790 YW = YW +7:X = XW +12:Y = YW: GOSUB 9000
  189. 2800  IF PR(4) = 0  THEN 2840
  190. 2810  HCOLOR= CN: FOR X = XW -3 TO XW +2: HPLOT X,YW TO X,YW +5: NEXT X
  191. 2820  HCOLOR=  INT(CN/5) *4 +3: HPLOT XW -3,YW TO XW +2,YW TO XW +2,YW +5 TO XW -3,YW +5 TO XW -3,YW
  192. 2830  GOTO 2850
  193. 2840  DRAW CN +22 AT XW,YW
  194. 2850  RETURN 
  195. 2900  REM  COLOR SLICE ROUTINE
  196. 2910 CN = CN +1: IF CN = 4  THEN CN = 5
  197. 2920  IF CN = 7  THEN PR(4) = 0:CN = 1: GOTO 3020
  198. 2930  HCOLOR= CN
  199. 2940  FOR CD = C1 TO C2  STEP .01
  200. 2950  HPLOT XC,YC TO  FN X(CD), FN Y(CD)
  201. 2960  NEXT 
  202. 2970  HCOLOR=  INT(CN/5) *4 +3: HPLOT  FN X(C1), FN Y(C1) TO XC,YC TO  FN X(C2), FN Y(C2)
  203. 2980  GOSUB 2700
  204. 2990  RETURN 
  205. 3000  REM  B&W SLICE ROUTINE
  206. 3010 CN = CN +1
  207. 3020  HCOLOR= 3
  208. 3030  HPLOT XC,YC TO  FN X(C2), FN Y(C2)
  209. 3040 RA = RA *.7: DRAW CN +22 AT  FN X((C1 +C2)/2), FN Y((C1 +C2)/2):RA = RA/.7
  210. 3050  GOSUB 2700
  211. 3060  RETURN 
  212. 9000  REM HGR PRINT
  213. 9010 C = 6: IF D >2  THEN C =  -6
  214. 9020  ROT= 16 *(D +F +1)
  215. 9030  FOR CT = 1 TO  LEN(W$)
  216. 9040 L =  ASC( MID$ (W$,CT,1))
  217. 9050  IF 64 <L  AND L <91  THEN SH = L -42: GOTO 9160
  218. 9060  IF L >48  AND L <58  THEN SH = L -37: GOTO 9160
  219. 9070  IF L = 32  THEN 9170
  220. 9080  IF L >39  AND L <48  THEN SH = L -36: GOTO 9160
  221. 9090  IF L = 48  THEN SH = 37: GOTO 9160
  222. 9100  IF L >34  AND L <38  THEN SH = L -34: GOTO 9160
  223. 9110  IF L = 61  THEN SH = 21: GOTO 9160
  224. 9120  IF L = 63  THEN SH = 22: GOTO 9160
  225. 9130  IF L = 94  THEN SH = 49: GOTO 9160
  226. 9140  PRINT "ERR- NO SHAPE FOR CHARACTER: "; CHR$(L); CHR$(7)
  227. 9150  GOTO 9170
  228. 9160  DRAW SH AT X,Y
  229. 9170  IF D/2 < > INT(D/2)  THEN X = X +C: GOTO 9190
  230. 9180  IF D/2 =  INT(D/2)  THEN Y = Y +C
  231. 9190  NEXT CT
  232. 9200  RETURN